CD ROM Paradise Collection 4/CD ROM Paradise Collection 4 1995 Nov.iso/music/cdplay.zip/CDPLAYER.FRM

Text File | 1994-04-01 | 19KB | 597 lines

VERSION 2.00
Begin Form CDForm
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "CD Player"
   ClientHeight    =   2400
   ClientLeft      =   2745
   ClientTop       =   2070
   ClientWidth     =   7185
   FontBold        =   -1  'True
   FontItalic      =   -1  'True
   FontName        =   "MS Sans Serif"
   FontSize        =   8.25
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   ForeColor       =   &H00FFFFFF&
   Height          =   3090
   Icon            =   CDPLAYER.FRX:0000
   Left            =   2685
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2400
   ScaleWidth      =   7185
   Top             =   1440
   Width           =   7305
   Begin SSPanel TrackPanel3D
      Alignment       =   2  'Left Justify - BOTTOM
      BackColor       =   &H00C0C0C0&
      Font3D          =   0  'None
      Height          =   1440
      Left            =   60
      TabIndex        =   15
      Top             =   45
      Width           =   7095
      Begin SSPanel frmDisabledCD
         Alignment       =   8  'Center - BOTTOM
         BackColor       =   &H00C0C0C0&
         BevelOuter      =   0  'None
         Caption         =   "Please Wait. . ."
         Font3D          =   0  'None
         Height          =   1320
         Left            =   120
         TabIndex        =   2
         Top             =   45
         Width           =   6855
         Begin PictureBox picLogo
            AutoSize        =   -1  'True
            BackColor       =   &H00C0C0C0&
            BorderStyle     =   0  'None
            Height          =   615
            Left            =   2205
            ScaleHeight     =   615
            ScaleWidth      =   2535
            TabIndex        =   3
            Top             =   120
            Width           =   2535
            Begin Label lblLogo
               AutoSize        =   -1  'True
               BackStyle       =   0  'Transparent
               Caption         =   "CD Player"
               FontBold        =   -1  'True
               FontItalic      =   -1  'True
               FontName        =   "MS Serif"
               FontSize        =   24
               FontStrikethru  =   0   'False
               FontUnderline   =   0   'False
               ForeColor       =   &H00C00000&
               Height          =   525
               Index           =   2
               Left            =   -30
               TabIndex        =   4
               Top             =   0
               Width           =   2445
            End
            Begin Label lblLogo
               AutoSize        =   -1  'True
               BackStyle       =   0  'Transparent
               Caption         =   "CD Player"
               FontBold        =   -1  'True
               FontItalic      =   -1  'True
               FontName        =   "MS Serif"
               FontSize        =   24
               FontStrikethru  =   0   'False
               FontUnderline   =   0   'False
               ForeColor       =   &H00FFFFFF&
               Height          =   525
               Index           =   3
               Left            =   0
               TabIndex        =   5
               Top             =   30
               Width           =   2415
            End
         End
      End
      Begin PictureBox minipicLogo
         AutoSize        =   -1  'True
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   0  'None
         Height          =   210
         Left            =   3045
         ScaleHeight     =   210
         ScaleWidth      =   1095
         TabIndex        =   10
         Top             =   60
         Width           =   1095
         Begin Label lblminiLogo
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Caption         =   "CD Player"
            FontBold        =   -1  'True
            FontItalic      =   -1  'True
            FontName        =   "MS Serif"
            FontSize        =   8.25
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            ForeColor       =   &H00C00000&
            Height          =   195
            Index           =   0
            Left            =   120
            TabIndex        =   11
            Top             =   -15
            Width           =   900
         End
         Begin Label lblminiLogo
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Caption         =   "CD Player"
            FontBold        =   -1  'True
            FontItalic      =   -1  'True
            FontName        =   "MS Serif"
            FontSize        =   8.25
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            ForeColor       =   &H00FFFFFF&
            Height          =   195
            Index           =   1
            Left            =   120
            TabIndex        =   12
            Top             =   0
            Width           =   900
         End
      End
      Begin SSPanel DisplayTracks
         BackColor       =   &H00C0C0C0&
         BevelInner      =   1  'Inset
         BevelOuter      =   0  'None
         Font3D          =   0  'None
         Height          =   855
         Left            =   105
         TabIndex        =   18
         Top             =   225
         Width           =   6855
         Begin SSOption TrackNum
            Font3D          =   0  'None
            FontBold        =   -1  'True
            FontItalic      =   0   'False
            FontName        =   "MS Sans Serif"
            FontSize        =   9.75
            FontStrikethru  =   0   'False
            FontUnderline   =   0   'False
            Height          =   255
            Index           =   0
            Left            =   240
            TabIndex        =   13
            Top             =   105
            Visible         =   0   'False
            Width           =   200
         End
         Begin Label TrackLabel
            BackStyle       =   0  'Transparent
            Caption         =   "1"
            Height          =   255
            Index           =   0
            Left            =   240
            TabIndex        =   14
            Top             =   345
            Visible         =   0   'False
            Width           =   135
         End
      End
      Begin SSCheck Repeat
         Caption         =   "&Repeat"
         Font3D          =   0  'None
         Height          =   255
         Left            =   6030
         TabIndex        =   17
         Top             =   1095
         Width           =   975
      End
      Begin PictureBox PicTotalTime
         AutoRedraw      =   -1  'True
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   0  'None
         Height          =   255
         Left            =   135
         ScaleHeight     =   255
         ScaleWidth      =   3015
         TabIndex        =   16
         Top             =   1095
         Width           =   3015
      End
   End
   Begin SSPanel CDButton3DPanel
      BackColor       =   &H00C0C0C0&
      BevelInner      =   1  'Inset
      Font3D          =   0  'None
      Height          =   855
      Left            =   45
      TabIndex        =   6
      Top             =   1530
      Width           =   7095
      Begin MMControl MMControl1
         BackVisible     =   0   'False
         BorderStyle     =   0  'None
         DeviceType      =   "CDAudio"
         Height          =   615
         Left            =   150
         RecordVisible   =   0   'False
         StepVisible     =   0   'False
         TabIndex        =   9
         Top             =   120
         Width           =   2640
      End
      Begin SSPanel Status
         BackColor       =   &H00C0C0C0&
         BevelInner      =   1  'Inset
         BevelOuter      =   0  'None
         Font3D          =   0  'None
         Height          =   495
         Left            =   3000
         TabIndex        =   8
         Top             =   120
         Width           =   3975
      End
      Begin SSPanel CDStatusBar
         BackColor       =   &H00C0C0C0&
         BevelInner      =   1  'Inset
         BevelOuter      =   0  'None
         FloodShowPct    =   0   'False
         FloodType       =   1  'Left To Right
         Font3D          =   0  'None
         FontBold        =   -1  'True
         FontItalic      =   0   'False
         FontName        =   "MS Serif"
         FontSize        =   6
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         ForeColor       =   &H00000000&
         Height          =   200
         Left            =   3000
         TabIndex        =   7
         Top             =   575
         Width           =   3975
      End
   End
   Begin PictureBox CDPicture
      AutoRedraw      =   -1  'True
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      DragIcon        =   CDPLAYER.FRX:0302
      DrawMode        =   4  'Not Copy Pen
      FillStyle       =   0  'Solid
      ForeColor       =   &H00000000&
      Height          =   480
      Left            =   150
      Picture         =   CDPLAYER.FRX:0604
      ScaleHeight     =   32
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   32
      TabIndex        =   1
      TabStop         =   0   'False
      Tag             =   "9130"
      Top             =   2505
      Width           =   480
   End
   Begin TextBox txtFloatTitle
      BackColor       =   &H00E0FFFF&
      FontBold        =   -1  'True
      FontItalic      =   -1  'True
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   285
      Left            =   1260
      TabIndex        =   0
      Text            =   "Text1"
      Top             =   2655
      Visible         =   0   'False
      Width           =   735
   End
   Begin Timer Timer1
      Left            =   795
      Top             =   2520
   End
   Begin Menu mnuExit
      Caption         =   "E&xit"
   End
   Begin Menu mnuOptions
      Caption         =   "&Options"
      Begin Menu mnuOptionsItem
         Caption         =   "&Display Track Time In Icon"
         Index           =   0
      End
      Begin Menu mnuOptionsItem
         Caption         =   "-"
         Index           =   1
      End
      Begin Menu mnuOptionsItem
         Caption         =   "Alway on &Top"
         Index           =   2
      End
      Begin Menu mnuOptionsItem
         Caption         =   "&Floating Titles"
         Index           =   3
      End
   End
   Begin Menu mnuCDInfo
      Caption         =   "&CD Info"
      Begin Menu mnuCDInfoItem
         Caption         =   "A&dd To/Edit CD Database"
         Index           =   0
      End
      Begin Menu mnuCDInfoItem
         Caption         =   "About This &CD"
         Index           =   1
      End
      Begin Menu mnuCDInfoItem
         Caption         =   "-"
         Index           =   2
      End
      Begin Menu mnuCDInfoItem
         Caption         =   "&About CD Player"
         Index           =   3
      End
   End
End
Option Explicit

Sub CDStatusBar_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call UpdateSeek(CDTime(TrackIndex), X)
End Sub

Sub Form_Load ()
    ' Initialize some variables to default values
    CRLF = Chr$(13) & Chr$(10)
    NumOfTracks = 1
    AppPath = App.Path

    CenterLogo Me, frmDisabledCD
    CenterForm CDForm, True

    ' Check for CD Installed
    If MMInstalled() = True Then
        InitMMControl
        ' Check to see if In Play Mode
        If CDForm.MMControl1.Mode = 526 Then MMControl1_PlayClick 0
    End If

    ' Get Option Settings
    GetOptionSettings

End Sub

Sub Form_Resize ()

    If CDForm.WindowState <= 1 And CDForm.mnuOptionsItem(2).Checked = True Then
        ' Because of the way VB is handling the ICON Window, it destroys
        ' the old window and creates a new one, thus totally screwing up Alway On Top!
        OnTop Me ' Call to turn check off
        OnTop Me ' Turn back on new Window
    End If

    If CDForm.WindowState = 1 And CDForm.mnuOptionsItem(0).Checked = True Then
        ' Turn on an Icon if not checked
        CDForm.Icon = LoadPicture()
    Else
        CDForm.Icon = CDForm.CDPicture.Picture
    End If
End Sub

Sub Form_Unload (Cancel As Integer)
    Dim Answer As Integer

    If MMControl1.Mode = MCI_MODE_PLAY Then
        Answer = MsgBox(CDInfo.CDTitle & " is still playing!" & CRLF & "Are you sure you want to Exit?", 4, "Attention")
        If Answer = 6 Then ' Yes
            ' Save Option Settings
            SaveOptionSettings
            MMControl1.Command = "Close"
        Else ' No
            Cancel = True
        End If
    Else
        ' Save Option Settings
        SaveOptionSettings
        MMControl1.Command = "Close"
    End If
End Sub

Sub MMControl1_EjectClick (Cancel As Integer)
    MMControl1.Command = "Eject"
    MMControl1.Command = "Close"
    UpdateCaption 0, "None"
    CDForm.txtFloatTitle.Visible = False
    Timer_Control True
End Sub

Sub MMControl1_PauseClick (Cancel As Integer)
    CDForm.Caption = CDInfo.CDTitle & " (Paused)"
End Sub

Sub MMControl1_PlayClick (Cancel As Integer)
    Dim I As Integer

    MMControl1.UpdateInterval = 1000
    MMControl1.From = TrackIndex
    If CDForm.Caption = CDInfo.CDTitle & " (Paused)" Then
        MMControl1.Command = "Seek"
    End If

End Sub

Sub MMControl1_PlayCompleted (ErrorCode As Long)
    If ErrorCode = 262 Then
        MMControl1.Command = "Close"
        Timer_Control True
    End If
End Sub

Sub MMControl1_StatusUpdate ()
    Static Stopped As Integer

    If MMControl1.Mode = MCI_MODE_STOP And CDForm.Caption <> CDInfo.CDTitle & "(Paused)" Then

        ' Repeat
        If Repeat.Value = True And MMControl1.NotifyValue = 1 Then
            Call UpdateCaption(1, "Rewinding")
            MMControl1.From = "1"
            MMControl1.Command = "Play"
            Exit Sub
        End If

        If Stopped = True Then Exit Sub

        ' Update Form Caption
        Call UpdateCaption(CDInfo.CDTrack, "Stopped")

        ' Update CD Info
        Call UpdateCDInfo(0, "00:00")

        ' Set Icon Timer to 00:00
        If CDForm.mnuOptionsItem(0).Checked = True Then
            CDForm.Cls
            CDForm.Print "00:00"
        End If

        ' Set Stopped Flag
        Stopped = True

    ElseIf MMControl1.Mode = MCI_MODE_PLAY Then
        If CDForm.WindowState = 0 Then
            ' Clear Form and Reset Flags
            CDForm.Cls
            Stopped = False

            ' Get CD Track, Minute and Second Info
            CDInfo.CDTrack = GetCDTrack()

            ' Update Form Caption
            Call UpdateCaption(CDInfo.CDTrack, "Play")

            ' Update CD Info
            Call UpdateCDInfo(CInt(CDInfo.CDTrack), GetCDTime())

            ' Floating Titles
            If mnuOptionsItem(3).Checked = True Then FloatingTitle

        ElseIf CDForm.WindowState = 1 Then
            If mnuOptionsItem(0).Checked = True Then AnimateIcon GetCDTime()

            ' Update Form Caption
            Call UpdateCaption(GetCDTrack(), "Play")
        End If
    ElseIf MMControl1.Mode = MCI_MODE_READY Then
        MMControl1.Command = "Close"
        UpdateCaption 0, "None"
        CDForm.txtFloatTitle.Visible = False
        Timer_Control True
    End If

End Sub

Sub MMControl1_StopClick (Cancel As Integer)
    ' Update Form Caption
    Call UpdateCaption(CDInfo.CDTrack, "Stopped")

    ' Update CD Info
    CDForm.Status.Caption = "Length: -None- Time: -None-"

End Sub

Sub mnuCDInfoItem_Click (Index As Integer)
    Select Case Index
        Case 0 ' Add CD Info
            CDEntry.Show 1
        Case 1 ' About The CD
            CDAbout.Show 1
        Case 3 ' About CDPlayer
            About.Show 1
    End Select
End Sub

Sub mnuExit_Click ()
    Unload Me
End Sub

Sub mnuOptionsItem_Click (Index As Integer)
    Select Case Index
        Case 0 ' Animation
                mnuOptionsItem(0).Checked = Not mnuOptionsItem(0).Checked
        Case 1 ' Bar
        Case 2 ' Always On Top
            OnTop Me
        Case 3
            mnuOptionsItem(Index).Checked = Not mnuOptionsItem(Index).Checked
    End Select
End Sub

Sub Timer1_Timer ()
    Dim I As Integer

    MMControl1.Command = "Open"
    If MMControl1.Error = 266 Then
        ' Control Disabled! No CD Present
        CDForm.frmDisabledCD.Caption = "Please Insert A CD!"

        frmDisabledCD.Visible = True
        ChangeMenuStatus False
        If Tracks_Loaded = True Then Call LoadTracks(NumOfTracks, False)
        PicTotalTime.Cls
        ReDim CDTracks(0)
    Else
        ' Initialize the control
        If Tracks_Loaded = True Then Call LoadTracks(NumOfTracks, False)
        InitMMControl
        ChangeMenuStatus True
        CDStatusBar.FloodPercent = 0
        Call Timer_Control(False)
    End If
End Sub

Sub TrackLabel_Click (Index As Integer)
    ' Seek to Track
    TrackNum(Index).Value = True
    TrackPanel3D.Refresh
End Sub

Sub TrackNum_Click (Index As Integer, Value As Integer)
    TrackIndex = Index

    ' Check if just Setting Option
    If TrackNumChange = True Then Exit Sub

    ' Seek to Track
    MMControl1.To = TrackIndex
    MMControl1.Command = "Seek"
    MMControl1.Track = TrackIndex
    MMControl1.SetFocus
End Sub

Sub TrackNum_MouseMove (Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Static SavedIndex As Integer

    If SavedIndex = Index Then Exit Sub

    If mnuOptionsItem(3).Checked = True Then
        MouseX = X
        MouseY = Y
        txtFloatTitle.Visible = False
        txtFloatTitle = (Mid$(CDTrackNo(Index), 5, (Len(CDTrackNo(Index)) - 5)))
        txtFloatTitle.Width = CDForm.TextWidth(txtFloatTitle) + 100
        txtFloatTitle.Height = CDForm.TextHeight(txtFloatTitle)
        txtFloatTitle.ZOrder 0
        txtFloatTitle.Left = TrackNum(Index).Left
        If (txtFloatTitle.Left + txtFloatTitle.Width) > (TrackPanel3D.Left + TrackPanel3D.Width) Then
            txtFloatTitle.Left = TrackNum(Index).Left + ((TrackPanel3D.Left + TrackPanel3D.Width) - (txtFloatTitle.Left + txtFloatTitle.Width))
        End If
        txtFloatTitle.Top = TrackNum(Index).Top
        txtFloatTitle.Tag = Index
        SavedIndex = Index
        txtFloatTitle.Visible = True
    End If
End Sub